perm filename TAK.MCL[TIM,LSP]4 blob sn#647778 filedate 1982-03-04 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00003 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	(declare 
C00009 00003	(timit)
C00010 ENDMK
C⊗;
(declare 
 (fixnum (tak fixnum fixnum fixnum))
 (fixnum (trtak fixnum fixnum fixnum))
 (fixnum (btak fixnum fixnum fixnum))
 (fixnum (btak2 fixnum fixnum fixnum)))

(defun tak (x y z)
       (cond ((not (< y x))	;x≤y
	      z)
	     (t (tak (tak (1- x) y z)
		     (tak (1- y) z x)
		     (tak (1- z) x y))))) 

(defun tak-dcl (x y z)
       (cond ((not (< y x))	;x≤y
	      z)
	     (t (tak-dcl (tak-dcl (1- x) y z)
		     (tak-dcl (1- y) z x)
		     (tak-dcl (1- z) x y))))) 

(defun trtak (x y z)
       (prog ()
	     tak
	     (cond ((not (< y x))
		    (return z))
		   (t (let ((a (tak (1- x) y z))
			    (b (tak (1- y) z x)))
			   (setq z (tak (1- z) x y))
			   (setq x a y b)(go tak))))))

(defun btak (x y z)
 (prog ()
       (cond ((not (< y x))
	      (return z)))
       tak2
       (let ((a (let ((c (1- x)))
		     (cond ((not (< y c)) z)
			   (t (btak2 c y z)))))
	     (b (let ((c (1- y)))
		     (cond ((not (< z c)) x)
			   (t (btak2 c z x)))))
	     (c (let ((c (1- z)))
		     (cond ((not (< x c)) y)
			   (t (btak2 c x y))))))
	    (cond ((not (< b a)) (return c))
		  (t (setq x a
			   y b
			   z c)
		     (go tak2))))))

(defun btak2 (x y z)
 (prog ()
       tak2
       (let ((a (let ((c (1- x)))
		     (cond ((not (< y c)) z)
			   (t (btak2 c y z)))))
	     (b (let ((c (1- y)))
		     (cond ((not (< z c)) x)
			   (t (btak2 c z x)))))
	     (c (let ((c (1- z)))
		     (cond ((not (< x c)) y)
			   (t (btak2 c x y))))))
	    (cond ((not (< b a)) (return c))
		  (t (setq x a
			   y b
			   z c)
		     (go tak2))))))

(defun btak-dcl (x y z)
 (prog ()
       (cond ((not (< y x))
	      (return z)))
       tak-dcl2
       (let ((a (let ((c (1- x)))
		     (cond ((not (< y c)) z)
			   (t (btak-dcl2 c y z)))))
	     (b (let ((c (1- y)))
		     (cond ((not (< z c)) x)
			   (t (btak-dcl2 c z x)))))
	     (c (let ((c (1- z)))
		     (cond ((not (< x c)) y)
			   (t (btak-dcl2 c x y))))))
	    (cond ((not (< b a)) (return c))
		  (t (setq x a
			   y b
			   z c)
		     (go tak-dcl2))))))

(defun btak-dcl2 (x y z)
 (prog ()
       tak-dcl2
       (let ((a (let ((c (1- x)))
		     (cond ((not (< y c)) z)
			   (t (btak-dcl2 c y z)))))
	     (b (let ((c (1- y)))
		     (cond ((not (< z c)) x)
			   (t (btak-dcl2 c z x)))))
	     (c (let ((c (1- z)))
		     (cond ((not (< x c)) y)
			   (t (btak-dcl2 c x y))))))
	    (cond ((not (< b a)) (return c))
		  (t (setq x a
			   y b
			   z c)
		     (go tak-dcl2))))))

(defun trtimit ()
 ((lambda (t1 x gt)
	(trtak 18. 12. 6.)
	  (setq t1 (- (runtime) t1))
	  (setq gt (- (status gctime) gt))
	  (print (list 'runtime
		       (QUOTIENT (FLOAT  (- t1 gt))
				 1000000.)))
	  (print (list 'gctime
		       (quotient (float gt) 1000000.))))
  (runtime) ()(status gctime)))

(defun timit ()
 ((lambda (t1 x gt)
	(tak 18. 12. 6.)
	  (setq t1 (- (runtime) t1))
	  (setq gt (- (status gctime) gt))
	  (print (list 'runtime
		       (QUOTIENT (FLOAT  (- t1 gt))
				 1000000.)))
	  (print (list 'gctime
		       (quotient (float gt) 1000000.))))
  (runtime) ()(status gctime)))

(defun timit-dcl ()
 ((lambda (t1 x gt)
	(tak-dcl 18. 12. 6.)
	  (setq t1 (- (runtime) t1))
	  (setq gt (- (status gctime) gt))
	  (print (list 'runtime
		       (QUOTIENT (FLOAT  (- t1 gt))
				 1000000.)))
	  (print (list 'gctime
		       (quotient (float gt) 1000000.))))
  (runtime) ()(status gctime)))

(defun btimit ()
 ((lambda (t1 x gt)
	(btak 18. 12. 6.)
	  (setq t1 (- (runtime) t1))
	  (setq gt (- (status gctime) gt))
	  (print (list 'runtime
		       (QUOTIENT (FLOAT  (- t1 gt))
				 1000000.)))
	  (print (list 'gctime
		       (quotient (float gt) 1000000.))))
  (runtime) ()(status gctime)))


(defun btimit-dcl ()
 ((lambda (t1 x gt)
	(btak-dcl 18. 12. 6.)
	  (setq t1 (- (runtime) t1))
	  (setq gt (- (status gctime) gt))
	  (print (list 'runtime
		       (QUOTIENT (FLOAT  (- t1 gt))
				 1000000.)))
	  (print (list 'gctime
		       (quotient (float gt) 1000000.))))
  (runtime) ()(status gctime)))

;(timit)
;(RUNTIME 0.564) 
;(GCTIME 0.0) 
;T 
;(RUNTIME 0.564) 
;(GCTIME 0.0) 
;T 
;(trtimit)
;(RUNTIME 0.565) 
;(GCTIME 0.0) 
;T 
;(RUNTIME 0.565) 
;(GCTIME 0.0) 
;T 
;(btimit)
;(RUNTIME 0.616) 
;(GCTIME 0.0) 
;T 
;(RUNTIME 0.617) 
;(GCTIME 0.0) 
;T 
;(timit-dcl)
;(RUNTIME 0.832) 
;(GCTIME 0.0) 
;T 
;(RUNTIME 0.832) 
;(GCTIME 0.0) 
;T 
;(btimit-dcl)
;(RUNTIME 0.795) 
;(GCTIME 0.0) 
;T 
;(RUNTIME 0.798) 
;(GCTIME 0.0) 
;T